Plotly Choropleth

Load Libraries

library(tidyverse)
library(tidycensus)
library(sf)
library(plotly)
library(crosstalk)
library(leaflet)
library(gganimate)

Get Census Data

nc_2016 <- 
  get_acs(geography = "county",
          variables = "B01003_001",
          state = "NC",
          geometry = TRUE) %>% 
  mutate(year = "2016")

nc_2015 <- 
  get_acs(geography = "county",
          variables = "B01003_001",
          state = "NC",
          year = 2015,
          geometry = TRUE) %>% 
  mutate(year = "2015")

nc_2014 <- 
  get_acs(geography = "county",
          variables = "B01003_001",
          state = "NC",
          year = 2014,
          geometry = TRUE) %>% 
  mutate(year = "2014")

nc_2013 <- 
  get_acs(geography = "county",
          variables = "B01003_001",
          state = "NC",
          year = 2013,
          geometry = TRUE) %>% 
  mutate(year = "2013")

Bind Rows

big_table <- rbind(nc_2016, nc_2015, nc_2014, nc_2013) 
glimpse(big_table)

Observations: 400
Variables: 7
$ GEOID    <chr> "37001", "37003", "37005", "37007", "37009", "3701...
$ NAME     <chr> "Alamance County, North Carolina", "Alexander Coun...
$ variable <chr> "B01003_001", "B01003_001", "B01003_001", "B01003_...
$ estimate <dbl> 157844, 37159, 10935, 25531, 26833, 17535, 47316, ...
$ moe      <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
$ year     <chr> "2016", "2016", "2016", "2016", "2016", "2016", "2...
$ geometry <MULTIPOLYGON [°]> MULTIPOLYGON (((-79.54192 3..., MULT...

big_table2 <- big_table
st_geometry(big_table2) <- NULL

Test

first: ggplot facet_wrap

ggplot(big_table) +
  geom_sf(aes(fill = estimate, color = estimate)) +
  facet_wrap(~ year)

Second: side by side bargraph

big_table2 %>% 
  mutate(county = str_extract(NAME, "\\w+")) %>% 
  filter(county == "Mecklenburg" | 
           county == "Durham" | 
           county == "Guilford") %>% 
  select(county, estimate, year) %>% 
  gather("foo", "year", -county, -estimate) %>% 
  ggplot() +
  geom_col(aes(x = county, y = estimate, fill = year), 
           position = "dodge") +
  scale_fill_viridis_d() +
  coord_flip() 

Third: Simple ggplotly for one year (2016) but no slider.

ggnc <- ggplot(nc_2016) +
  geom_sf(aes(fill = estimate, color = estimate)) 
ggplotly(ggnc)

fourth: crosstalk shared data & slider

shared_bigtable <- SharedData$new(big_table %>% 
  mutate(year = as.numeric(year)))

filter_slider("mapyear", "YEAR", shared_bigtable, 
              column=~year, timeFormat = "%Y")

YEAR

GreenPalette <- colorNumeric(palette = "Greens",
                               domain = big_table$estimate)
big_table %>% 
  st_transform(crs = "+init=epsg:4326") %>%
  leaflet(width = "100%") %>%
  addProviderTiles(provider = "CartoDB.Positron") %>% 
  addPolygons(fillOpacity = 0.7,
              smoothFactor = 0,
              stroke = FALSE, 
              color = ~GreenPalette(estimate))

nc_share_leaf <- (shared_bigtable %>% 
  #st_transform(crs = "+init=epsg:4326") %>%
  leaflet(width = "100%") %>%
  addProviderTiles(provider = "CartoDB.Positron") %>% 
  addPolygons(fillOpacity = 0.7,
              smoothFactor = 0,
              stroke = FALSE, 
              color = ~GreenPalette(estimate)))

sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
Need '+proj=longlat +datum=WGS84'

YEAR

Fifth: annimate with gganimate

big3p

p

Frame 1 (1%)
Frame 2 (2%)
Frame 3 (3%)
Frame 4 (4%)
Frame 5 (5%)
Frame 6 (6%)
Frame 7 (7%)
Frame 8 (8%)
Frame 9 (9%)
Frame 10 (10%)
Frame 11 (11%)
Frame 12 (12%)
Frame 13 (13%)
Frame 14 (14%)
Frame 15 (15%)
Frame 16 (16%)
Frame 17 (17%)
Frame 18 (18%)
Frame 19 (19%)
Frame 20 (20%)
Frame 21 (21%)
Frame 22 (22%)
Frame 23 (23%)
Frame 24 (24%)
Frame 25 (25%)
Frame 26 (26%)
Frame 27 (27%)
Frame 28 (28%)
Frame 29 (29%)
Frame 30 (30%)
Frame 31 (31%)
Frame 32 (32%)
Frame 33 (33%)
Frame 34 (34%)
Frame 35 (35%)
Frame 36 (36%)
Frame 37 (37%)
Frame 38 (38%)
Frame 39 (39%)
Frame 40 (40%)
Frame 41 (41%)
Frame 42 (42%)
Frame 43 (43%)
Frame 44 (44%)
Frame 45 (45%)
Frame 46 (46%)
Frame 47 (47%)
Frame 48 (48%)
Frame 49 (49%)
Frame 50 (50%)
Frame 51 (51%)
Frame 52 (52%)
Frame 53 (53%)
Frame 54 (54%)
Frame 55 (55%)
Frame 56 (56%)
Frame 57 (57%)
Frame 58 (58%)
Frame 59 (59%)
Frame 60 (60%)
Frame 61 (61%)
Frame 62 (62%)
Frame 63 (63%)
Frame 64 (64%)
Frame 65 (65%)
Frame 66 (66%)
Frame 67 (67%)
Frame 68 (68%)
Frame 69 (69%)
Frame 70 (70%)
Frame 71 (71%)
Frame 72 (72%)
Frame 73 (73%)
Frame 74 (74%)
Frame 75 (75%)
Frame 76 (76%)
Frame 77 (77%)
Frame 78 (78%)
Frame 79 (79%)
Frame 80 (80%)
Frame 81 (81%)
Frame 82 (82%)
Frame 83 (83%)
Frame 84 (84%)
Frame 85 (85%)
Frame 86 (86%)
Frame 87 (87%)
Frame 88 (88%)
Frame 89 (89%)
Frame 90 (90%)
Frame 91 (91%)
Frame 92 (92%)
Frame 93 (93%)
Frame 94 (94%)
Frame 95 (95%)
Frame 96 (96%)
Frame 97 (97%)
Frame 98 (98%)
Frame 99 (99%)
Frame 100 (100%)
Finalizing encoding... done!

plot_13 <- ggplot(nc_2013) +
  geom_sf(aes(fill = estimate, color = estimate)) 
plot_13

Sixth: foo

ggnc <- ggplot() +
  geom_sf(data = nc_2016, 
          aes(fill = estimate, color = estimate)) +
  geom_sf(data = nc_2013, 
          aes(fill = estimate, color = estimate)) 

ggnc




ggpp <- ggplotly(ggnc) %>% 
  add_trace(
    z = ~estimate,
    frame = ~year)

ggpp

animation_slider(ggpp)

ggplotly(ggnc, tooltip = "NAME") %>% 
  layout(
    hovermode = "x",
    margin = list(
      t = 20,
      b = 20,
      l = 20,
      r = 20),
  )

County Level Plotly

https://moderndata.plot.ly/county-level-choropleth-in-plotly-and-r/

county_df <- map_data("county") 
nc_county <- county_df %>% filter(region == "north carolina")

  
state_df <- map_data("state") 
nc_df <- state_df %>% filter(region == "north carolina")

Make Plotly Map

boarder_white <- list(color = toRGB("white"), width = 2)

usa_projection <- list(scope = "usa", 
                       projection = list(type = "albers usa"),
                       showlakes = TRUE,
                       lakecolor = toRGB("white"))

plotlymap <- plot_geo(big_table, locationmode = 'county names') %>% 
  add_trace(
    z = ~estimate, text = ~estimate, location = ~NAME,
    color = ~estimate, colors = "Purples",
    frame = ~NAME
  ) %>% 
  layout = usa_projection

plotlymap

ggplotly()